home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Splaymap.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.1 KB  |  130 lines  |  [TEXT/R*ch]
  1. (* Splaymap -- modified for Moscow ML from 
  2.  * SML/NJ library v. 0.2 which is 
  3.  * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  
  4.  * See file mosml/copyrght/copyrght.att for details.
  5.  *
  6.  * Applicative map (or, dictionary) structure implemented by splay-trees.
  7.  *)
  8.  
  9. open Splaytree
  10.  
  11. datatype ('key, 'a) dict = 
  12.   DICT of {cmpKey : 'key * 'key -> order,
  13.        root   : ('key * 'a) splay ref,
  14.        nobj   : int}
  15.  
  16. exception NotFound
  17.  
  18. fun cmpf cmpKey k = fn (k',_) => cmpKey(k',k)
  19.  
  20. fun mkDict cmpKey = DICT{cmpKey = cmpKey, root = ref SplayNil, nobj = 0}
  21.  
  22. (* Insert an item. *)
  23. fun insert (DICT{cmpKey,root,nobj},key,v) =
  24.     case splay (cmpf cmpKey key, !root) of
  25.         (_,SplayNil) => 
  26.           DICT{cmpKey=cmpKey,nobj=1,
  27.            root=ref(SplayObj{value=(key,v),left=SplayNil,right=SplayNil})}
  28.       | (EQUAL,SplayObj{value,left,right}) => 
  29.           DICT{cmpKey=cmpKey,nobj=nobj,
  30.            root=ref(SplayObj{value=(key,v),left=left,right=right})}
  31.       | (LESS,SplayObj{value,left,right}) => 
  32.           DICT{cmpKey=cmpKey,
  33.            nobj=nobj+1,
  34.            root=ref(SplayObj{value=(key,v),
  35.                  left=SplayObj{value=value,
  36.                            left=left,
  37.                            right=SplayNil},
  38.                  right=right})
  39.           }
  40.       | (GREATER,SplayObj{value,left,right}) => 
  41.         DICT{cmpKey=cmpKey,
  42.          nobj=nobj+1,
  43.          root=ref(SplayObj{value=(key,v),
  44.                    left=left,
  45.                    right=SplayObj{value=value,
  46.                           left=SplayNil,
  47.                           right=right}
  48.             })
  49.           }
  50.  
  51. (* Find an item, raising NotFound if not found *)
  52. fun find (d as DICT{cmpKey,root,nobj},key) =
  53.       case splay (cmpf cmpKey key, !root) of
  54.         (_,SplayNil) => raise NotFound
  55.       | (EQUAL,r as SplayObj{value,...}) => (root := r; #2 value)
  56.       | (_,r) => (root := r; raise NotFound)
  57.  
  58.     (* Look for an item, return NONE if the item doesn't exist *)
  59. fun peek arg = (SOME(find arg)) handle NotFound => NONE
  60.  
  61. (* Remove an item.  Raise NotFound if not found. *)
  62. fun remove (DICT{cmpKey,root,nobj}, key) = 
  63.     (case (splay (cmpf cmpKey key, !root))
  64.        of (_,SplayNil) => raise NotFound
  65.         | (EQUAL,SplayObj{value,left,right}) => 
  66.           (DICT{cmpKey=cmpKey,
  67.             root=ref(join(left,right)),
  68.             nobj=nobj-1}, #2 value)
  69.         | (_,r) => (root := r; raise NotFound))
  70.  
  71. (* Return the number of items in the table *)
  72. fun numItems (DICT{nobj,...}) = nobj
  73.     
  74. (* Return a list of the items (and their keys) in the dictionary *)
  75. fun listItems (DICT{root,...}) =
  76.     let fun apply SplayNil                     res = res
  77.           | apply (SplayObj{value,left,right}) res =
  78.         apply left (value :: apply right res)
  79.     in apply (!root) [] end
  80.  
  81. (* Apply a function to the entries of the dictionary *)
  82. fun app af (DICT{root,...}) =
  83.       let fun apply SplayNil = ()
  84.             | apply (SplayObj{value,left,right}) = 
  85.                 (apply left; af value; apply right)
  86.     in
  87.       apply (!root)
  88.     end
  89.  
  90. fun revapp af (DICT{root,...}) =
  91.     let fun apply SplayNil = ()
  92.       | apply (SplayObj{value,left,right}) = 
  93.         (apply right; af value; apply left)
  94.     in apply (!root) end
  95.  
  96. (* Fold function *)
  97. fun foldr abf b (DICT{root,...}) =
  98.     let fun apply SplayNil                     res = res
  99.       | apply (SplayObj{value,left,right}) res =
  100.         apply left (abf(#1 value, #2 value, apply right res))
  101.     in apply (!root) b end
  102.  
  103. fun foldl abf b (DICT{root,...}) =
  104.     let fun apply SplayNil                     res = res
  105.       | apply (SplayObj{value,left,right}) res =
  106.         apply right (abf(#1 value, #2 value, apply left res))
  107.     in apply (!root) b end
  108.  
  109. (* Map a table to a new table that has the same keys*)
  110. fun map af (DICT{cmpKey,root,nobj}) =
  111.     let fun ap SplayNil                     = SplayNil
  112.       | ap (SplayObj{value,left,right}) = 
  113.         let val left' = ap left
  114.         val value' = (#1 value, af value)
  115.         in SplayObj{value = value', left = left', right = ap right} end
  116.     in
  117.       DICT{cmpKey=cmpKey,root = ref(ap (!root)), nobj = nobj}
  118.     end
  119.  
  120. fun transform af (DICT{cmpKey,root,nobj}) =
  121.     let fun ap SplayNil = SplayNil
  122.       | ap (SplayObj{value,left,right}) = 
  123.         let
  124.         val left' = ap left
  125.         val value' = (#1 value, af (#2 value))
  126.         in
  127.         SplayObj{value = value', left = left', right = ap right}
  128.         end
  129.     in DICT{cmpKey=cmpKey, root = ref(ap (!root)), nobj = nobj} end
  130.